perm filename CARF1.SAI[AER,HPM]2 blob sn#168752 filedate 1975-07-12 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "CARF1"
C00006 ENDMK
C⊗;
BEGIN "CARF1"
REQUIRE "VIXNIC.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "CARR.SAI[AER,HPM]" SOURCE_FILE;

INTEGER I,J,K,L,M,N,PSIZ,DCHAN,PSIZ2;
STRING FN;
BOOLEAN SYNA;

DO OUTSTR("PICTURE:") UNTIL (PSIZ←PFLDIM(FN←INCHWL))≠0;
   BEGIN
   INTEGER ARRAY PA[0:PSIZ];
   GETPFL(FN,PA[0]);
   PSIZ2←PIXDIM(PA[PCLN]%2,PA[LNBY]%2,PA[BYBI]);
   END;

DDINIT;
SCREEN(-.5,1.5,1.5,-.5);
DRKEN; RECTAN(-1000,-1000,1000,1000);
FOR I←0 STEP 1 UNTIL 5 DO FOR J←0,0,0,0 DO DPYUP(SYNMAP(I));
SHOWA('47);

   BEGIN
   INTEGER ARRAY PA[0:PSIZ2];
   INTEGER BITS;

      BEGIN
      INTEGER ARRAY PB[0:PSIZ];
      GETPFL(FN,PB[0]);
      MAKPIX(PB[PCLN]%2,PB[LNBY]%2,PB[BYBI],PA[0]);
      SELECT(PB[0],PB[PCLN]%2,PB[LNBY]%2,PA[0]);
      END;

   BITS←PA[BYBI];
   FOR I←1 STEP 1 UNTIL (BITS MIN 5) DO
      BEGIN
      INTEGER XP,YP,DBIT;
      DBIT←BITS-I;
      DRKEN; RECTAN(0,0,1,1);
      VIDEO(0,0,1,1,PA[0],1 ASH DBIT);
      FOR J←1,2,3 DO DPYUP(SYNMAP(5-I));
      SHOWA('47);
      END;

      BEGIN
      REAL ARRAY QC[0:PA[PCLN]-CARH12,0:PA[LNBY]-CARW12];
      INTEGER XL,XH,YL,YH; REAL AVRG,LOA,HIA;

      XL←0; YL←0; XH←PA[LNBY]-1; YH←PA[PCLN]-1;
      outstr("into vcar"&'15&'12);
      AVRG←VCAR(PA[0],XL,YL,XH,YH,QC[0,0]);
      outstr("out of vcar"&'15&'12);
      PUTPFL(PA[0],"A");
      AVRG←0;
      FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
      FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
         BEGIN
         IF QC[I,J]>1.0∨QC[I,J]<0 THEN OUTSTR(CVF(QC[I,J])&" ");
         QC[I,J]←QC[I,J] MAX 0;
         HIA←HIA MAX QC[I,J];
         LOA←LOA MIN QC[I,J];
         END;
      AVRG←HIA/(2↑PA[BYBI]-2);
      FOR I←100 STEP 1 UNTIL PSIZ2 DO PA[I]←0;
      MAKPIX(PA[PCLN],PA[LNBY],PA[BYBI],PA[0]);
      FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
      FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
         PUTEL(PA[0],I+CARH12%2,J+CARW12%2,2↑PA[BYBI]-2-QC[I,J]/AVRG);
      PUTPFL(PA[0],"B");
      DRKEN; RECTAN(-1000,-1000,1000,1000);
      VIDEO(0,0,1,1,PA[0],(1 ASH 2↑PA[BYBI])%2);
      FOR J←1,1,1 DO DPYUP(SYNMAP(5));
      SHOW('47);
      END;
   END;
END;